home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / bsprite.com / PAL.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-02-16  |  1.3 KB  |  55 lines
  1. DEFINT A-Z
  2. SCREEN 13
  3. YPOS = 2
  4. FOR x = 0 TO 255 STEP 16
  5.    LINE (x + 4, YPOS * 8)-(x + 4, 5 * 8)
  6.    LOCATE YPOS, x / 8 + 1
  7.    IF YPOS = 4 THEN YPOS = 2 ELSE YPOS = YPOS + 1
  8.    PRINT LTRIM$(STR$(x));
  9.    FOR y = 40 TO 190 STEP 10
  10.       LINE (x, y)-(x + 16, y + 16), a, BF
  11.       a = a + 1
  12.    NEXT y
  13. NEXT x
  14.  
  15. DIM pal(255) AS LONG
  16. DEF FNPAL& (r, g, b) = 65536 * b + 256 * g + r
  17. 'color number = 65536 * blue + 256 * green + red
  18.  
  19. curve = 2
  20. FOR x = 0 TO 7
  21.    prop = x * 7 + 14
  22.    curve = curve * 1.525
  23.    FOR binary.flags = 1 TO 7
  24.       red = 0: green = 0: blue = 0
  25.       IF binary.flags AND 4 THEN red = 1
  26.       IF binary.flags AND 2 THEN green = 1
  27.       IF binary.flags AND 1 THEN blue = 1
  28.       attribute = ((binary.flags + 1) * 8) + x
  29.       colour& = FNPAL&(red * prop, green * prop, blue * prop)
  30.       pal(attribute) = colour&
  31.       PALETTE attribute, colour&
  32.       attribute = attribute + 56
  33.       colour& = FNPAL&(red * curve, green * curve, blue * curve)
  34.       pal(attribute) = colour&
  35.       PALETTE attribute, colour&
  36.    NEXT binary.flags
  37. NEXT x
  38.  
  39. WHILE INKEY$ = "": WEND
  40.  
  41. LOCATE 25, 1
  42. PRINT "Write output file?";
  43. WHILE i$ = ""
  44.    i$ = INKEY$
  45. WEND
  46. IF UCASE$(i$) = "Y" THEN
  47.    OPEN "PALETTE" FOR OUTPUT AS #1
  48.    FOR x = 0 TO 255
  49.       IF pal(x) <> 0 THEN PRINT #1, x, pal(x)
  50.    NEXT x
  51. END IF
  52.  
  53. END
  54.  
  55.